home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / UTILITY / GEMERRLO.M < prev    next >
Encoding:
Text File  |  1993-05-01  |  2.1 KB  |  68 lines
  1. MODULE GEMErrLocator;
  2.  
  3. (*
  4.  * Wenn bei Aufruf einer GEM-Funktion ein Fehler auftritt, merkt
  5.  * man in der Regel dort erstmal nichts, weil selten der Fehler
  6.  * mittels "GEMEnv.GemError()" abgefragt wird. Dafür wird dann
  7.  * aber beim nächsten GEM-Aufruf automatisch über die "GEMEnv.
  8.  * ErrorProc" ein Fehler angezeigt, dessen Text etwa so lautet:
  9.  *
  10.  *  "Fehler bei letztem GEM-Aufruf"
  11.  *
  12.  * Wie soll man den nun finden? Welches ist der vorige GEM-Aufruf,
  13.  * bei dem der Fehler auftrat?
  14.  *
  15.  * Dazu dient dieses Modul. Wird es gestartet, meldet es über
  16.  * "GEMEnv.ErrHdlProc" jeden GEM-Fehler sofort. Dann wird die
  17.  * bekannte Scan-Box angezeigt, sodaß Sie darin die aufrufende
  18.  * Funktion leicht finden können.
  19.  *
  20.  * Um das Modul wieder zu entfernen, brauchen Sie es nur erneut
  21.  * zu starten oder die Shell zu verlassen.
  22.  *)
  23.  
  24. FROM ModCtrl IMPORT InstallModule, ReleaseModule, FirstModuleStart;
  25. FROM PrgCtrl IMPORT TermProcess;
  26. FROM MOSGlobals IMPORT MemArea;
  27. FROM SysTypes IMPORT ScanDesc;
  28. FROM SysCtrl IMPORT GetScanAddr;
  29. FROM GEMScan IMPORT InitChain, InputScan;
  30. FROM AESForms IMPORT FormAlert;
  31. FROM GEMEnv IMPORT GemError, ErrHdlProc;
  32.  
  33. PROCEDURE showGEMerror;
  34.   VAR scanidx, button: CARDINAL;
  35.       scan: ScanDesc;
  36.       dummy: BOOLEAN;
  37.   BEGIN
  38.     dummy:= GemError (); (* GEM-Fehler abfragen, um autom. Meldung abzustellen*)
  39.     GetScanAddr (scan); (* eigene Scan-Position ermitteln *)
  40.     InitChain (scan);   (* Scan-Positionen der Aufruferkette ermitteln *)
  41.     scanidx:= 2;
  42.     InputScan ('GEM-Fehler aufgetreten!', scanidx); (* Scanner anzeigen *)
  43.     (* Nachfragen, ob Programm beendet werden soll *)
  44.     FormAlert (1, "[0][ Programm beenden? ][ Ja |Nein]", button);
  45.     IF button = 1 THEN
  46.       TermProcess (-1)
  47.     END
  48.   END showGEMerror;
  49.  
  50. VAR oldValue: PROC;
  51.  
  52. PROCEDURE release;
  53.   BEGIN
  54.     (* Modul entfernen, vorigen Err-Handler wieder installieren *)
  55.     ErrHdlProc:= oldValue;
  56.     ReleaseModule ()
  57.   END release;
  58.  
  59. BEGIN
  60.   IF FirstModuleStart () THEN
  61.     oldValue:= ErrHdlProc;
  62.     ErrHdlProc:= showGEMerror;
  63.     InstallModule (release, MemArea {NIL, 0})
  64.   ELSE
  65.     release
  66.   END
  67. END GEMErrLocator.
  68.